home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Mainl.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  3.1 KB  |  134 lines  |  [TEXT/R*ch]
  1. (* The Caml Light linker. Command-line parsing. *)
  2.  
  3. local
  4.   open List Fnlib Config Mixture Symtable Link;
  5. in
  6.  
  7. val object_files = ref ([] : string list);
  8. val exec_file = ref default_exec_name;
  9.  
  10. fun anonymous s =
  11.   let val name =
  12.     if Filename.check_suffix s ".sml" then
  13.       Filename.chop_suffix s ".sml" ^ ".uo"
  14.     else if Filename.check_suffix s ".uo" then
  15.       s
  16.     else
  17.       raise Arg.Bad ("Don't know what to do with file "^s)
  18.   in
  19.     object_files := name :: !object_files
  20.   end;
  21.  
  22. fun set_stdlib p =
  23.   path_library := p;
  24. ;
  25.  
  26. fun add_include d =
  27.   load_path := !load_path @ [d]
  28. ;
  29.  
  30. fun perv_set set =
  31.   preloadedUnits := lookup (Fnlib.stringToLower set) preloadedUnitSets
  32.     handle Subscript =>
  33.       raise Arg.Bad ("Unknown preloaded unit set " ^ set)
  34. ;
  35.  
  36. fun set_debug () =
  37.   write_symbols := true
  38. ;
  39.  
  40. fun set_noheader () =
  41.   no_header := true
  42. ;
  43.  
  44. fun unset_autolink () =
  45.   Link.autolink := false
  46. ;
  47.  
  48. fun set_verbose () =
  49.   Link.verbose := true
  50. ;
  51.  
  52. fun set_exec_file e =
  53.   exec_file := e
  54. ;
  55.  
  56. fun show_version() =
  57. (
  58.   msgIBlock 0;
  59.   msgString "Moscow ML linker version 1.42 (July 1997)";
  60.   msgEOL();
  61.   msgString "Based in part on Caml Light";
  62.   msgEOL();
  63.   msgEBlock();
  64.   msgFlush();
  65.   BasicIO.exit 0
  66. );
  67.  
  68. fun process_include filename =
  69.   List.app anonymous (Readword.from_file filename)
  70. ;
  71.  
  72. fun main() =
  73. (
  74.   Miscsys.catch_interrupt true;
  75.   preloadedUnits := lookup "default" preloadedUnitSets;
  76.   load_path := [];
  77.   reset_linker_tables();
  78.   Arg.parse [("-stdlib",     Arg.String set_stdlib),
  79.              ("-I",          Arg.String add_include),
  80.              ("-include",    Arg.String add_include),
  81.              ("-P",          Arg.String perv_set),
  82.              ("-perv",       Arg.String perv_set),
  83.              ("-noautolink", Arg.Unit unset_autolink),
  84.              ("-i",          Arg.Unit set_verbose),
  85.              ("-g",          Arg.Unit set_debug),
  86.              ("-debug",      Arg.Unit set_debug),
  87.              ("-noheader",   Arg.Unit set_noheader),
  88.              ("-o",          Arg.String set_exec_file),
  89.              ("-exec",       Arg.String set_exec_file),
  90.              ("-v",          Arg.Unit show_version),
  91.              ("-version",    Arg.Unit show_version),
  92.              ("-files",      Arg.String process_include),
  93.              ("-",           Arg.String anonymous)
  94.             ] anonymous;
  95.   if !path_library <> "" then
  96.     load_path := !load_path @ [!path_library]
  97.   else ();
  98.   if null (!object_files) then
  99.     show_version()
  100.   else ();
  101.   object_files :=
  102.     (map (fn uname => uname ^".uo") (!preloadedUnits))
  103.     @ (rev (!object_files));
  104.   link (!object_files) (!exec_file);
  105.   msgFlush();
  106.   BasicIO.exit 0
  107.  
  108. ) handle
  109.     Toplevel =>
  110.       (msgFlush(); BasicIO.exit 2)
  111.   | Interrupt =>
  112.       (msgIBlock 0;
  113.        errPrompt "Interrupted."; msgEOL();
  114.        msgEBlock();
  115.        msgFlush();
  116.        BasicIO.exit 3)
  117.   | Impossible msg =>
  118.       (msgIBlock 0;
  119.        errPrompt "Internal error: "; msgString msg; msgEOL();
  120.        msgEBlock();
  121.        msgFlush();
  122.        BasicIO.exit 4)
  123.   | Fail msg =>
  124.       (msgIBlock 0;
  125.        errPrompt msg; msgEOL();
  126.        msgEBlock();
  127.        msgFlush();
  128.        BasicIO.exit 2)
  129. ;
  130.  
  131. val () = Printexc.f main ();
  132.  
  133. end;
  134.